perm filename ITMSUB.F4[XX,LCS]6 blob
sn#195543 filedate 1976-01-08 generic text, type T, neo UTF8
00100 C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200 C ********** WHOLE & HALF RESTS, BEAMS ******
00300 SUBROUTINE ITMSUB
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01100 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800 C RDBR IS SPACER FOR DBL BAR.
01900 C RTF COMPENSATES FOR BAD PLANNING.
02000 RST7=RSTJ2*7.
02100 RST18=RSTJ2*18.
02200 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300
02400 R3Q=R3
02500 CC??? JY=0
02600 IF(JA.EQ.6)GO TO 90
02700 IF(JA.EQ.8)GO TO 100
02800 C GO TO LINES, BEAMS, STAVES.
02900 C NEXT DRAWS STRAIGHT LINES
03000
03100 RD=R4*RST7
03200 RA=0
03300 RX=RTF*RSTJ2+POS
03400 C SOMEDAY ADD < RDIS=1./DIS > TO REPLACE ALL 1./DIS'S
03500 IF(J5.EQ.50)GO TO 300
03600 C 50 IS FOR CRESC., DECRESC. AND BOXES
03700 IF(R6.NE.0)GO TO 401
03800 IF(J7.NE.0)GO TO 401
03900 C FOR BAR LINES
04000 4000 JA=44
04100 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04200 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04300 DBR=0
04400 IF(J4.LT.1000)GO TO 400
04500 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04600 CK J4=J4-1000
04700 CK DBR=-1
04800 CK400 J7=(J4/100)*DIS
04900 DBR=J4/1000
05000 J4=J4-DBR*1000
05100 C DBR=1 HEAVY BAR IS ON RT. =2 ON LEFT. =3 IN MIDDLE.
05200 9400 RD=RDBR+RDBR*RSTJ2
05300 C TO SPACE THIN BAR FROM HEAVY
05400 IF(J5.EQ.0)GO TO 400
05500 C NEXT ADDS REPEAT DOTS TO DBL BAR.
05600 L=J4
05700 RJ=L/100
05800 IF(RJ.EQ.0)RJ=6.*RSTJ2
05900 C HEAVY BAR WILL BE 5 LINES WIDE.
05910 RZ=R3
06000 J4=0
06100 C MUST BE 0 FOR DOTS IN 'NOTWRT'
06200 IF(DBR.EQ.0)DBR=J5
06300 J5=0
06400 C J5=1 RPT ←, =2 RPT →, =3 RPT ↔
06500 RJA=RD*2.
06600 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06700 JY=DBR
06800 IF(DBR.LT.2)GO TO 8400
06900 R3=RJA+RJ+RZ
07000 7400 DO 3400 K=J2,MOD(L,100)+J2-1
07100 RSTJ2=RSTFAC(K)
07200 POS=STFF(K)
07300 R4=6
07400 CALL CENTX
07500 C SPACES DOTS OUT FROM BAR
07600 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
07700 C GO GET THE DOT
07800 R4=8
07900 CALL CENTX
08000 3400 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
08100 JY=JY-1
08200 IF(JY.LT.2)GO TO 4400
08300 8400 R3=RZ-RJA-4.*RSTJ2
08400 GO TO 7400
08500 C DO I NEED ANY MORE RESETS????
08600 4400 J4=L
08610 J7=RJ*DIS
08620 GO TO 5400
08700 400 IF(J5.NE.0)GO TO 9400
08800 K=J4/100
08900 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
09000 J7=K*DIS
09100 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09200 5400 L=MOD(J4,100)
09300 IF(L.EQ.0)L=1
09400 L=L+J2-1
09500 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09600 RA=RTF
09700 IF(L.LE.4)GO TO 2400
09800 L=4
09900 RA=300.
10000 C FOR EXTENDING BARS ABOVE STAFF 4
10100 2400 RY=RSTFAC(L)
10110 RZ=R3Q
10155 C SAVE IT FOR DBL RPT BAR.
10200 RY=STFF(L)+(RA+56.)*RY
10300 1400 RA=1
10400 IF(PLT.GE.0)GO TO 140
10500 J7=J7+1
10600 RA=1./DIS
10700 C BAR LINES PLOT AS DOUBLE THICKNESS
10800 140 RJX=R3Q
10900 42 CALL LINES(R3Q,RX,3)
11000 RJ=-1.
11100 RW=RY
11200 406 CALL LINES(RJX,RY,2)
11300 IF(J10.EQ.0)GO TO 411
11400 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11500 J7=J10*DIS
11600 J10=0
11700 RA=1./DIS
11800 411 IF(J7.GT.0)GO TO 409
11900 IF(DBR.LE.0)RETURN
12000 RY=RW
12100 CK R3Q=R3Q-RDBR
12200 RA=RZ-RD
12300 IF(DBR.NE.1)RA=RJX+RD-1.
12400 DBR=DBR-2
12500 R3Q=RA
12600 GO TO 1400
12700 CC411 IF(J7.LE.0)RETURN
12800 C FOR 'HEAVY' LINE.
12900 409 RJX=RJX+RA
13000 CALL LINES(RJX,RY,2)
13100 J7=J7-1
13200 RY=RW
13300 IF(RJ)RY=RX
13400 RJ=-RJ
13500 GO TO 406
13600 CC43 IF(RA.LE.0)RETURN
13700 C HOW IS RA.NE.0?
13800 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
13900 CC403 RA=RA-3.72
14000 CC R3Q=R3Q+22
14100 CC RJX=RJX+22
14200 C DO ABOVE NEED *RSTJ2? ************
14300 C **** BASED ON '596' ****
14400 CC GO TO 42
14500
14600 C FOR CRESC., DECRESC.
14700 300 IF(R7.EQ.0)R7=2.3
14800 IF(R7.EQ.-1.)R7=-2.3
14900 RA=ABS(R7/2.0)*RST7
15000 C AMOUNT OF SPREAD
15100 RJ=R3Q
15200 RX=RX-RST18+RD
15300 IF(R8.NE.0)GO TO 302
15400 C JUMP TO MAKE BOX
15500 R6=RHORZ(R6)
15600 IF(R7)GO TO 301
15700 RJ=R6
15800 R6=R3Q
15900 301 CALL LINX(RJ,RX+RA,R6,RX)
16000 CALL LINES(RJ,RX-RA,2)
16100 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16200 CC IF(PLT.NE.-2)RETURN
16300 IF(PLT.GE.0)RETURN
16400 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16500 IF(J8)RETURN
16600 RX=RX+1./DIS
16700 J8=-1
16800 C FOR DOUBLE THICKNESS
16900 GO TO 301
17000
17100 302 R8=R8*RST7
17200 R9=R9*RST7
17300 IF(R9.EQ.0)R9=R8
17400 C R9=0 MAKES SQUARE
17500 R3=R3Q-R8/2.
17600 RX=RX-R9/2.
17700 J10=J10*DIS
17800 C DRAWS BOX, CENTER IS IN MIDDLE
17900 C 4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
18000 1302 CALL LINX(R3,RX,R3+R8,RX)
18100 CALL LINES(R3+R8,RX+R9,2)
18200 CALL LINES(R3,RX+R9,2)
18300 CALL LINES(R3,RX,2)
18400 IF(J10.EQ.0)RETURN
18500 J10=J10-1
18600 RJ=1./DIS
18700 R3=R3-RJ
18800 R8=R8+RJ+RJ
18900 RX=RX-RJ
19000 R9=R9+RJ+RJ
19100 GO TO 1302
19200 C TO THICKEN BOXES.
19300
19400 1401 R4=2.0
19500 C FOR HEAVY BRACK.
19600 RA=RSTJ2*RBX
19700 RX=RX-RA
19800 C THE BOTTOM
19900 L=J4+J2-1
20000 R6=RTF
20100 IF(L.LE.4)GO TO 4401
20200 L=4
20300 R6=300.
20400 4401 RA=STFF(L)
20500 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20600 RJY=RSTFAC(L)
20700 RY=RA+R6*RJY+RJY*56.+RJY*RBX
20800 C THE TOP
20900 R5=9.5
21000 GO TO 2401
21100
21200 C DASHES
21300 401 POS=POS-RST18
21400 C********* 27/9/72 ******
21500 IF(J7.LE.0)GO TO 407
21600 IF(J7.EQ.4)GO TO 1401
21700 IF(J7.NE.3)GO TO 4001
21800 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
21900 2401 JA=3
22000 IF(J10.EQ.0)J10=5
22100 C DEFAULT VALUE FOR THICKNESS =5
22200 R4=R4-RBR
22300 J9=0
22400 J5=35
22500 C THE NUM FOR THE LITTLE END ITEMS
22600 CC RY=R6-2.1*RSTJ2
22700 R6=3
22800 R7=0
22900 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23000 IF(J8.NE.2)CALL CLEFS
23100 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
23200 R4=R5-RBR
23300 R6=3
23400 R7=-3
23500 C TURNS IT UPSIDE DOWN.
23600 CC JA=3
23700 IF(J7.NE.4)GO TO 3401
23800 POS=RA
23900 R4=R4*RJY/RSTJ2
24000 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24100 3401 IF(J8.NE.1)CALL CLEFS
24200 R3Q=R3Q-12.0*RSTJ2
24300 IF(J7.NE.4)GO TO 407
24400 J7=0
24500 GO TO 140
24600
24700 4002 J5=4
24800 C FOR CURVY BRACKET. P6 CAN CHANGE WIDTH.
24900 R8=0
25000 J4=J4+J2-1
25100 R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
25200 C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25300 C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25400 IF(R6.EQ.0)R6=1.+R7/20.
25500 JA=3
25600 R4=2.3
25700 C C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
25800 CALL CLEFS
25900 RETURN
26000
26100 4001 IF(J7.EQ.5)GO TO 4002
26200 IF(R8.EQ.0)R8=.8
26300 C P8 CAN SET SIZE OF DASH
26400 RD=RD+POS
26500 IF(J7.EQ.1)GO TO 402
26600 C =1 =VERTICAL DASHES
26700 RA=RHORZ(R6)
26800 RST7=5.96*RSTJ2
26900 RJX=R3Q
27000 GO TO 420
27100 402 RA=POS+R5*RST7
27200 RJY=RD
27300 C SAVE FOR THICK LINES
27400 420 RJ=R8*RST7
27500 41 L=3
27600 K=2
27700 416 CALL LINES(R3Q,RD,L)
27800 IF(J7.EQ.1)GO TO 412
27900 C JUMP FOR VERTICAL DASH
28000 IF(R3Q.GE.RA)GO TO 413
28100 C JUMP IF ALL DONE
28200 R3Q=R3Q+RJ
28300 414 CALL EXCH(L,K)
28400 GO TO 416
28500 412 IF(RD.GE.RA)GO TO 413
28600 C JUMP IF DONE
28700 RD=RD+RJ
28800 GO TO 414
28900 413 IF(J10.LE.0)RETURN
29000 C NEXT FOR THICK DASHES
29100 J10=J10-1
29200 IF(J7.EQ.1)GO TO 415
29300 R3Q=RJX
29400 RD=RD+1./DIS
29500 GO TO 41
29600 415 R3Q=R3Q+1./DIS
29700 RD=RJY
29800 GO TO 41
29900
30000
30100 407 RX=RD+POS
30200 RY=R5*RST7+POS
30300 IF(J7.EQ.3)GO TO 140
30400 CALL NOZERO(R9)
30500 IF(J7.EQ.-1)GO TO 408
30600 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
30700 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
30800 RJX=IFIX(ROFF(RHORZ(R6)))
30900 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31000 IF(J7.EQ.0)GO TO 42
31100 RY=R9*RST7+RX
31200 CALL NOZERO(R8)
31300 4041 RZ=RX
31400 RH=RY
31500 C SAVE FOR THICK WIGGLES
31600 CALL LINES(R3Q,RX,3)
31700 C DRAWS STRAIGHT LINES. ETC.
31800 R9=R3Q
31900 RJ=RY
32000 RW=3.*RSTJ2*R8
32100 RA=RW*2.5
32200 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
32300 404 R9=R9+RA
32400 CALL LINES(R9,RJ,2)
32500 R9=R9+RW
32600 CALL LINES(R9,RJ,2)
32700 405 CALL EXCH(RX,RJ)
32800 IF(R9.LT.RJX)GO TO 404
32900 IF(J10.LE.0)RETURN
33000 RX=RZ+1./DIS
33100 RY=RH+1./DIS
33200 J10=J10-1
33300 GO TO 4041
33400 C P10= + NUM OF THICKNESSES TO WIGGLE
33500
33600 408 IF(RX.GT.RY)CALL EXCH(RX,RY)
33700 RZ=R9*RSTJ2*5.96
33800 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
33900 CALL NOZERO(R8)
34000 RD=R8*RST7*.5
34100 RJ=RD
34200 IF(RD.LT.1.)RD=1.
34300 421 R9=RX
34400 RW=R3Q
34500 RA=RZ+R3Q
34600 CALL LINES(RW,R9,3)
34700 410 R9=R9+RJ
34800 CALL LINES(RA,R9,2)
34900 R9=R9+RD
35000 CALL LINES(RA,R9,2)
35100 CALL EXCH(RA,RW)
35200 IF(R9.LT.RY)GO TO 410
35300 IF(J10.LE.0)RETURN
35400 R3Q=R3Q+1./DIS
35500 J10=J10-1
35600 GO TO 421
35700 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
35800
37900
38200 C NEXT IS FOR BEAMS
38300 90 RMINI=RSTJ2
38400 RX=2.7*RSTJ2*5.96
38500 C******************************
38600 R6=RHORZ(R6)
38700 IF(R8.NE.0)GO TO 204
38800 IF(R10.GE.10)GO TO 204
38900 IF(J7)GO TO 204
39000 IF(R9.NE.0)GO TO 1
39100 C R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLETS, ETC.)
39200 204 IF(R9.NE.0)R9=RHORZ(R9)
39300 IF(J7)GO TO 201
39400 200 IF(J10.LT.10)GO TO 91
39500 C NEXT FOR INNER, PARTIAL BEAMS
39600 R8=RHORZ(R8)
39700 R10=AMOD(R10,10.)
39800 GO TO(2,3,4),J10/10
39900 2 RH=R9+RX
40000 GO TO 1
40100 3 R8=R9-RX
40200 C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
40300 4 RH=R8
40400 C LEFT INNER POS.
40500 GO TO 1
40600 201 J7=-J7
40700 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=DISP.
40800 CALL NOZERO(R10)
40900 C ALWAYS AT LEAST 1 IN DISPLACEMENT
41000 J10=30
41100 C TO ACTIVATE PARTIAL BEAM SECTION
41200 IF(J9.NE.0)GO TO 202
41300 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
41400 RH=-1
41500 IF(J7.GE.20)RH=-RH
41600 CC203 R4=R4+R10*RH
41700 CC CALL CENTX
41800 R5=R4+RH
41900 R9=R3
42000 R6=R3+22.*RMINI
42100 202 IF(R8.EQ.0)R8=4.
42200 RX=R8*RMINI*2.98
42300 RH=R9+RX
42400 R9=R9-RX
42500 GO TO 1
42600
42700 91 IF(J8.EQ.0)GO TO 1
42800 IF(J8.GT.0)GO TO 92
42900 C FOR J8=-(10+DN) OR -(20+DN)
43000 R9=R3+RX
43100 IF(J8.LE.-20)R9=R6-RX
43200 192 J8=-J8
43300 92 IF(J10.EQ.0)J10=MOD(J8,10)
43400 CC??? 4/75 J8=J8-J10
43500 IF(J10.EQ.0)J10=1
43600 R10=J10
43700 C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
43800 1 IF(IABS(J4).LT.100)GO TO 97
43900 RMINI=.6*RSTJ2
44000 R5=AMOD(R5,100.0)
44100 C SPACE BETWEEN BEAMS
44200 97 RJ=RMINI*11.
44300 RW=RMINI*RHGT
44400 C DIST. UP OR DOWN FROM NOTE HEAD.
44500 RJA=R10*RJ
44600 C DISPLACEMENT
44700 RD=R9
44800 C POSITION 3
44900 RJX=CENTR-RW+RJA
45000 C FINAL HEIGHT OF LEFT SIDE
45100 C NEG R7=TREMOLO
45200 RX=MOD(J7,10)
45300 JJ2=J7-20
45400 RA=R6
45500 C HORIZANTAL DIST.
45600 RJY=R5*RST7+POS-RST18-RW+RJA
45700 C VERTICAL POS OF RIGHT SIDE.
45800 RW=R14*RMINI
45900 RY=1.
46000 IF(J7.GE.20)GO TO 98
46100 C JUMP IF STEMS ARE DOWN
46200 RY=-RY
46300 C FOR THICKENING INCR.
46400 JJ2=J7-10
46500 RJ=-RJ
46600 RJA=RMINI*R2HGT-2.*RJA
46700 RJX=RJX+RJA
46800 RJY=RJY+RJA
46900 R3Q=R3Q+RW
47000 C POSITION 1
47100 RA=RA+RW
47200 C POSITION 2
47300 RD=RD+RW
47400 C******************************
47500 RH=RH+RW
47600 98 RSTJ2=RSTJ2*RBM
47700 C RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
47800 93 IF(JJ2.GT.RX)GO TO 94
47900 IF(J10.GE.10)GO TO 7
48000 C**********************
48100 IF(J8.EQ.0)GO TO 94
48200 R3=RW
48300 IF(J9.EQ.0)GO TO 292
48400 IF(J8.GE.20)GO TO 193
48500 293 RX=R3Q-RD
48600 GO TO 194
48700 7 RHX=RH-R3Q
48800 R3=RD-R3Q
48900 GO TO 292
49000 193 RX=RD-RA
49100 194 R3=ABS(RX)
49200 292 DISX=ABS(R3Q-RA)
49300 HGT=RJX-RJY
49400 IF(J10.GE.10)HGT1=HGT*RHX/DISX
49500 C**********************
49600 R3=R3/DISX
49700 195 HGT=HGT*R3
49800 196 L=J8/10
49900 J8=0
50000 IF(J10.GE.10)GO TO 8
50100 C***************
50200 IF(L.EQ.1)GO TO 95
50300 C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
50400 R3Q=RD
50500 RJX=RJY+HGT
50600 GO TO 94
50700 C**************
50800 8 R3Q=RH
50900 RA=RD
51000 RJY=RJX-HGT
51100 RJX=RJX-HGT1
51200 GO TO 94
51300 95 RA=RD
51400 RJY=RJX-HGT
51500 94 L=7.*RMINI
51600 930 RC=0
51700 C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
51800 CALL LINES(R3Q,RJX,3)
51900 DO 941 K=1,L
52000 CALL BMS
52100 IF(PLT.GE.0)GO TO 940
52200 RC=RC+RY
52300 C FOR THICKENING.
52400 CALL BMS
52500 CALL EXCH(RA,R3Q)
52600 941 CALL EXCH(RJY,RJX)
52700 CALL BMS
52800 C DRAWS 5 LINES FOR BEAMS.
52900 940 JJ2=JJ2-1
53000 IF(JJ2.LE.0)GO TO 942
53100 C IF P7=10 OR 20 ONE BEAM WILL APPEAR.
53200 RJY=RJY+RJ
53300 RJX=RJX+RJ
53400 GO TO 930
53500
53600 942 IF(R8.NE.0)RETURN
53700 IF(R9.EQ.0)RETURN
53800 IF(R10.GE.30)RETURN
53900 C FOR NUMBERS OUTSIDE BEAMS
54000 RSTJ2=RMINI
54100 RD=-10.
54200 IF(R7.LT.20)RD=8.3
54300 943 J3=R3Q+(RA-R3Q)/2.
54400 R6=1.
54500 CC *** DONE IN CENTX *** R4=AMOD(R4,100.)
54600 R4=R4+(R5-R4)/2.+RD
54700 R7=1
54800 C ITALICS
54900 CALL MAKNUM(R9)
55000 RETURN
55100
55200 100 RA=0
55300 C FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S),
55400 C P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
55500 C P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS.
55600 C PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
55700 IF(R5.EQ.0)R5=RSTFAC(J2)
55800 CALL NOZERO(R5)
55900 RSTFAC(J2)=R5
56000 RX=(J2+3)*123-369.+R4*7.*R5
56100 CC RC=R5
56200 STFF(J2)=RX
56300 RX=RX+RTF*R5
56400 C FOR RTF SEE DATA
56500 RA=RX
56600 C FOR 2 PASS PLOTTING
56700 RJ=RHORZ(R6)
56800 IF(R6.EQ.0)RJ=596
56900 R5=R5*14.
57000 IF(R8.EQ.0)GO TO 68
57100 IF(PLT)GO TO 68
57200 RZ=RX+R8*167.
57300 C 167 IS A MAGIC NUMBER!! PUTS LINE ON DPY.
57400 CALL LINX(R3,RZ,RJ,RZ)
57500 C SHOWS WHERE NEXT STAFF 0 WILL BE.
57600 68 IF(J7.EQ.0)GO TO 101
57700 IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
57800 C TO ACTIVATE DPY BUFFER
57900 RETURN
58000 101 DO 6 K=1,5
58100 RZ=RJ
58200 RW=R3
58300 IF(K.EQ.2)GO TO 66
58400 IF(K.NE.4)GO TO 67
58500 66 CALL EXCH(RW,RZ)
58600 67 CALL LINX(RZ,RX,RW,RX)
58700 6 RX=RX+R5
58800 IF(RA.EQ.1000)RETURN
58900 IF(PLT.NE.-2)RETURN
59000 RX=RA-1./RHT
59100 CC R5=RC
59200 RA=1000
59300 GO TO 101
59400 END
59500
59600 CC SUBROUTINE BMS
59700 CC COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RJY
59800 CC CALL LINES(RA,RJY+RC*RSTJ2,2)
59900 CC END
60000
60100 SUBROUTINE METER
60200 COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
60300 COMMON/POSI/STFF(-3/4),JJ2,POS
60400 EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
60500 1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
60600
60700 C PARAMS 18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
60800
60900 CALL NOZERO(R7)
61000 JZ=J3
61100 RY=R4+8.*R7
61200 C HEIGHT
61300 RW=R6
61400 C BOTTOM NUM
61500 C P5=TOP NUM
61600 R6=R7
61700 RR6=R6
61800 C SIZE
61900 C FOR BDR40 -- OR =1
62000 M=0
62100 R4=RY
62200 2 R7=0
62300 C R7=0 FOR BDR FONT??
62400 CC IF(R5.NE.99)GO TO 1
62500 IF(R5.LT.90)GO TO 3
62600 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
62700 M=-1
62800 IF(R5.NE.98)GO TO 4
62900 C NEXT FOR LINE THROUGH C.
63000 RZ=R6
63100 RY=R4
63200 RA=POS
63300 R6=RX3
63400 C TO LINE UP WITH R3
63500 J10=2
63600 C FOR THICK LINE
63700 R4=4.2
63800 R5=9.8
63900 J7=0
64000 R8=0
64100 CALL ITMSUB
64200 POS=RA
64300 R4=RY
64400 R6=RZ
64500 C GET BACK THE RIGHT PARAMS.
64600
64700 4 R5=9999.
64800 GO TO 3
64900 C TO CENTER 12S AND 16S
65000 3 CALL MAKNUM(R5)
65100 IF(M)RETURN
65200 C STICK AROUND FOR BOTTOM NUM
65300 M=-1
65400 R4=RY-4.*RR6
65500 R6=RR6
65600 R5=RW
65700 C GET BOTTOM NUM
65800 J3=JZ
65900 R8=0
66000 GO TO 2
66100 END
66200
66300 CF SUBROUTINE RNOTE(X)
66400 CF COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
66500 CF X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
66600 CF END
66700
66800 SUBROUTINE MAKNUM(RNUM)
66900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
67000 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
67100 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
67200 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
67300 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
67400 DATA RS/10.0/,RBX/1.0/
67500 RB8=R8
67600 J3X=J3
67700 C P7=0=BDR40; =1=BDI40; =2=PRIM.
67800 CALL NOZERO(R6)
67900 R5=R6
68000 C UPPER CASE - BDR40
68100 R6=48000000.0+(R7+50.)*10000.
68200 R7=99999999.0
68300 C BLANKS
68400 R8=R7
68500 IF(RNUM.NE.9999.)GO TO 2
68600 C NEXT FOR 'C'OMMON TIME
68700 RNUM=12.
68800 C MAKES A 'C'
68900 R4=R4-2.2
69000 C .2 FOR BAD POS. OF LETTERS
69100 GO TO 4
69200
69300 2 ONE=0
69400 RNUM=IFIX(RNUM)
69500 C SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
69600 IF(RNUM.EQ.1.)ONE=3.
69700 IF(RNUM.GT.9.)GO TO 3
69800 C JUMP FOR 2 OR 3 DIGIT NUMBER
69900 4 R6=R6+RNUM*100.+47.
70000 C PUTS BLANK ON END (.47)
70100 GO TO 1
70200
70300 3 RJY=10.
70400 IF(RNUM.GE.100.)RJY=100.
70500 B=IFIX(RNUM/RJY)
70600 C=AMOD(RNUM,RJY)
70700 IF(RNUM.LT.100)GO TO 7
70800 D=IFIX(C/10.)
70900 C=AMOD(C,10.)
71000 IF(C.EQ.1.)ONE=ONE+3.
71100 R7=C*1000000.+999999.0
71200 C=D
71300 7 R6=R6+B*100.+C
71400 IF(B.EQ.1.)ONE=ONE+3.
71500 IF(C.EQ.1.)ONE=ONE+3.
71600 B=R5
71700 IF(RNUM.GE.100.)B=B*2
71800 J3=J3-RS*RSTJ2*B
71900 C FOR 2 DIGIT NUMBER
72000 CCC IF(RNUM.GE.20.)GO TO 6
72100 CCC IF(JA.EQ.18)GO TO 6
72200 CCC RJY=5.6
72300 CCC IF(RNUM.GT.11.)RJY=3.
72400 C ADJUSTS FOR 11, ETC.
72500 CCC J2=J2+RJY*R5*RSTJ2
72600 CC6 J3=J2
72700 1 J3=J3+ONE*R5*RSTJ2
72800 C CENTERS THE NUMBER '1'
72900 CALL ALPHA
73000 J3=J3X
73100 IF(RB8.EQ.0)RETURN
73200 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
73300 R3=J3-R5
73400 IF(J10.EQ.0)J10=1
73500 C USE J10 FOR EVEN THICKER BOX AND CIRC.
73600 IF(RNUM.GT.9)R3=R3+R5*RBX
73700 C TO SET CENTER
73800 IF(RB8.EQ.2)GO TO 5
73900 R4=R4+R5+.1+.05/R5
74000 C END OF ABOVE IS FOR SMALL CIRCLES.
74100 B=4.5
74200 IF(RNUM.GE.100.)B=5.5
74300 R5=R5*B
74400 JA=12
74500 J6=0
74600 J7=0
74700 J8=J10
74800 CALL CENTX
74900 CALL SLUR
75000 RETURN
75100
75200 5 JA=4
75300 B=6
75400 R9=0
75500 IF(RNUM.LT.100.)GO TO 8
75600 B=9.
75700 R9=R5*6.
75800 C MAKES RECTANGLE IF ≥100
75900 8 R4=R4+R5*.7+.1
76000 R8=R5*B
76100 J5=50
76200 CALL ITMSUB
76300 C RETURNS ORIG. HORIZ. POS.
76400 END
76500 C MAKES ONLY 1 TO 3 DIGIT NUMS NOW. EXPAND LATER.
76600
76700 CC FUNCTION IABS(N)
76800 C BECAUSE IABS IN LIB40 HAS A BUG.
76900 CC IABS=N
77000 CC IF(N)IABS=-N
77100 CC END
77200
77300 CF SUBROUTINE DRWNT(RMINI)
77400 CF COMMON /STF/RSTFAC(-3/4),RSTJ2
77500 CF COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
77600 CF EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
77700 CF 1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
77800 CF 1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
77900 CF RJX=CENTR
78000 CF JH=0
78100 C JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
78200 CC CENTR=CENTR-21.*RSTJ2
78300 CF RA=R6
78400 CF R6=.5*RMINI/RSTJ2
78500 CF R7=R6
78600 CF RJD=RJZ-3
78700 CCXX IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
78800 C ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
78900 CF JI=0
79000 CF CALL CLEFS
79100 CF JI=R9
79200 C ↑↑↑↑↑↑ NEEDED??
79300 C FIX THIS???? ↑↑↑↑↑
79400 C FOR WHITE NOTES AND ACCIS ON PLOTTER.
79500 CF CENTR=RJX
79600 CF R6=RA
79700 CF R7=JG
79800 CF JE=RJE
79900 CF END
80000
80100 CC FUNCTION RHORZ(R)
80200 CC RHORZ=R*5.96-596.
80300 CC END
80400
80500 CF SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
80600 C TO X,Y INTO ONE WORD
80700 CF DIMENSION XY(1)
80800 CF DO 2 K=I,IFIX(S)
80900 CF L=2
81000 CF Y=XY(K)
81100 CF IF(Y.LT.1000.)GO TO 3
81200 CF L=3
81300 CF Y=Y-1000.
81400 C >1000 = INVIS. LINE
81500 CF3 M=Y
81600 CF Y=(Y-M)*1000.
81700 CF IF(Y.GT.100.)Y=100-Y
81800 C Y NUMBERS .GT.100 ARE NEG.
81900 CF B=Y*X+CENTR
82000 CF IF(M.GT.60)M=100-M
82100 CF A=M*RMINI+R3
82200 CF2 CALL LINES(A,B,L)
82300 CF END
82400
82500 CC FUNCTION EEXP(X,Y)
82600 CC EEXP=X**Y
82700 CC END